home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok11 / r.o.m. / m2sources / stringinput.mod < prev    next >
Text File  |  1993-11-04  |  12KB  |  387 lines
  1. IMPLEMENTATION MODULE StringInput;
  2. (*Created: 29.8.87
  3.   Changed: 22.1.88/20.02.88/27.7.88/11.9.88 by
  4.              Stefan Salewski
  5.              Stolper Weg 3
  6.              2160 Stade   West-Germany
  7.              Tel: 04141/61130
  8.   Note: compiled with AMIGA Modula-2 System by AMSoft, Version from 5.5.88
  9.    
  10.   This Module may be freely copied. But please
  11.   leave my name in. Thanks....Stefan
  12. *)
  13.   FROM SYSTEM IMPORT ADR,BYTE;
  14.   FROM DeactivateGadget IMPORT PressRButton;
  15.   FROM Intuition IMPORT IDCMPFlags,IDCMPFlagSet,GadgetPtr,ModifyIDCMP,
  16.     IntuiMessagePtr,WindowFlags,WindowFlagSet,NewWindow,ActivateGadget,
  17.     Window,WindowPtr,ScreenFlags,ScreenFlagSet,IntuiText,
  18.     StringInfo,Border,Gadget,GadgetFlags,GadgetFlagSet,ActivationFlags,
  19.     ActivationFlagSet,Image,strGadget,boolGadget,OpenWindow,CloseWindow;
  20.   FROM Exec IMPORT ReplyMsg,GetMsg,MessagePtr,AllocMem,CopyMem,MemReqs,
  21.     MemReqSet,WaitPort,FreeMem,UByte;
  22.   FROM Dos IMPORT Delay;
  23.   FROM Graphics IMPORT jam2, jam1,DrawModeSet;
  24.   FROM MyStrings IMPORT Length;
  25.   FROM MyUties IMPORT Min;
  26.   FROM Preference IMPORT CharSize;
  27.   FROM SYSTEM IMPORT LONGSET,ADDRESS,INLINE;
  28.   FROM Arts IMPORT Assert,TermProcedure;
  29.   CONST
  30.     OK1Size=300; (* I don't Know how I can find the exact Size ????? *)
  31.     Cancel1Size=300; (* I don't Know how I can find the exact Size ????? *)
  32.   
  33.   VAR charWidth,charHeight:INTEGER;
  34.     windowPtr:WindowPtr;
  35.     ok1Adr,cancel1Adr:ADDRESS;    
  36.   
  37. PROCEDURE OK1; (*$E- Bild fuer OKGadget *)
  38. BEGIN
  39. INLINE(
  40. 01FFFH,0FFFFH,0FFE0H,03FFFH,0FFFFH,0FFF8H,
  41. 07000H,00000H,0001CH,0E000H,00000H,0000EH,
  42. 0E000H,00000H,0000EH,0E003H,0F07CH,0380EH,
  43. 0E00EH,01C38H,0600EH,0E01CH,00E38H,0C00EH,
  44. 0E038H,00739H,0800EH,0E038H,0073BH,0000EH,
  45. 0E038H,0073EH,0000EH,0E038H,0073FH,0000EH,
  46. 0E038H,0073BH,0800EH,0E01CH,00E39H,0C00EH,
  47. 0E00EH,01C38H,0E00EH,0E003H,0F07CH,0F80EH,
  48. 0E000H,00000H,0000EH,0E000H,00000H,0000EH,
  49. 07000H,00000H,0001CH,03FFFH,0FFFFH,0FFF8H,
  50. 00FFFH,0FFFFH,0FFF0H,0FFFFH,0FFFFH,0FF00H,
  51. 0776FH,0726BH,0696EH,0672EH,02E2EH,06E6CH,
  52. 0792EH,00A0AH,02062H,06520H,06672H,06565H,
  53. 06C79H,02064H,06973H,07472H,06962H,07574H,
  54. 06564H,02066H,06F72H,0206EH,06F6EH,02D70H,
  55. 0726FH,06669H,0740AH,04EACH,089C2H,04E5DH,
  56. 04E75H,04E55H,00000H,0302CH,0AD32H,048C0H,
  57. 02F00H,0486CH,08DF4H,04EACH,083B6H,0504FH,
  58. 042A7H,04878H,000FFH,04878H,000CCH,0302CH,
  59. 08EF2H,048C0H,0322CH,08EFAH,048C1H,0B081H,
  60. 06C08H,0302CH,08EF2H,048C0H,06006H,0302CH
  61. )
  62. END OK1;
  63.  
  64. PROCEDURE Cancel1; (*$E- Bild fuer CancelGadget *)
  65. BEGIN
  66. INLINE
  67. (
  68. 01FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FF00H,
  69. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FF80H,
  70. 07000H,00000H,00000H,00000H,00000H,001C0H,
  71. 0E000H,00000H,00000H,00000H,00000H,000E0H,
  72. 0E000H,00000H,00000H,00000H,00000H,000E0H,
  73. 0E003H,0FD00H,00000H,00000H,0000FH,000E0H,
  74. 0E00EH,00700H,00000H,00000H,00007H,000E0H,
  75. 0E01CH,00300H,00000H,00000H,00007H,000E0H,
  76. 0E038H,00000H,00000H,00000H,00007H,000E0H,
  77. 0E038H,0001FH,0C77CH,003F8H,03E07H,000E0H,
  78. 0E038H,00060H,0E3C7H,00E1CH,0E387H,000E0H,
  79. 0E038H,00000H,0E383H,09C01H,0C1C7H,000E0H,
  80. 0E038H,0001FH,0E383H,09C01H,0FFC7H,000E0H,
  81. 0E01CH,00330H,0E383H,09C01H,0C007H,000E0H,
  82. 0E00EH,00670H,0E383H,08E0CH,0E1C7H,000E0H,
  83. 0E003H,0FC3FH,0F7C7H,0C3F8H,03F0FH,080E0H,
  84. 0E000H,00000H,00000H,00000H,00000H,000E0H,
  85. 0E000H,00000H,00000H,00000H,00000H,000E0H,
  86. 07000H,00000H,00000H,00000H,00000H,001C0H,
  87. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FF80H,
  88. 01FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0FF00H
  89. )
  90. END Cancel1;
  91.  
  92.   PROCEDURE Cleanup;
  93.   BEGIN
  94.     IF windowPtr#NIL THEN
  95.       CloseWindow(windowPtr);
  96.       windowPtr:=NIL
  97.     END;
  98.     IF ok1Adr#NIL THEN
  99.       FreeMem(ok1Adr,OK1Size);
  100.       ok1Adr:=NIL
  101.     END;
  102.     IF cancel1Adr#NIL THEN
  103.       FreeMem(cancel1Adr,OK1Size);
  104.       cancel1Adr:=NIL
  105.     END;
  106.   END Cleanup;
  107.   
  108.   PROCEDURE AskForStrings(VAR windowTitle:ARRAY OF CHAR;
  109.               anzStrings:Anzahl;
  110.               VAR daten:ARRAY OF Datum):BOOLEAN;
  111.  
  112.     CONST
  113.       CursorUpP=103;
  114.       CursorDownP=101;
  115.       OkWidth=47;OkHeight=21;
  116.       CancelWidth=91;CancelHeight=21;
  117.       LBorder=2;
  118.       RBorder=2;
  119.       TBorder=12;
  120.       Delta=2;
  121.     TYPE
  122.       Index=INTEGER[-1..MaxAnzGadgets-1];(*-1 to be an Integer*)
  123.     VAR
  124.       hRegister[0BFEC01H]:UByte; (* Tastatur-HardwareRegister *)
  125.       lastKey:UByte;
  126.       i,high,gaNummer:Index;
  127.       ende:BOOLEAN;
  128.       msgadr:GadgetPtr;
  129.       myGadgets:ARRAY Index OF Gadget;
  130.       okGadget:Gadget;
  131.       cancelGadget:Gadget;
  132.       newWindow:NewWindow;
  133.       msgPtr:IntuiMessagePtr;
  134.       class:IDCMPFlagSet;
  135.       myGadgetBorder:ARRAY Index OF Border;
  136.       myStringInfos:ARRAY Index OF StringInfo;
  137.       myIntuitionTexts:ARRAY Index OF IntuiText;
  138.       myUndoBuffer:Buffer;
  139.       myBorKoPairs:ARRAY Index OF ARRAY[0..4] OF RECORD
  140.                          x:INTEGER;
  141.                           y:INTEGER;
  142.                               END;
  143.       maxTL,maxSZ:INTEGER;
  144.       myOKImage,myCancelImage:Image;
  145.     
  146.     PROCEDURE InitGadgets;
  147.       PROCEDURE LaengsterString():CARDINAL;
  148.         VAR
  149.           i:Index;
  150.           l,max:CARDINAL;
  151.       BEGIN
  152.         max:=0;
  153.         FOR i:=0 TO anzStrings-1 DO
  154.           l:=Length(daten[i].text);
  155.           IF l>max THEN
  156.             max:=l
  157.           END;
  158.         END;
  159.         RETURN max;
  160.       END LaengsterString;
  161.       
  162.       PROCEDURE MaxSichtbareZeichen():CARDINAL;
  163.         VAR
  164.           i:Index;
  165.           max:CARDINAL;
  166.       BEGIN
  167.         max:=0;
  168.         FOR i:=0 TO anzStrings-1 DO
  169.           IF daten[i].sichtbareZeichen >max THEN 
  170.             max:=daten[i].sichtbareZeichen
  171.           END;
  172.         END;
  173.         RETURN max;
  174.       END MaxSichtbareZeichen;
  175.       
  176.     BEGIN (* InitGadgets *)
  177.       maxTL:=INTEGER(LaengsterString());
  178.       maxSZ:=INTEGER(MaxSichtbareZeichen());
  179.       high:=Min(MaxAnzGadgets-1,anzStrings-1);
  180.       FOR i:=0 TO high DO
  181.     myBorKoPairs[i,0].x:=0;
  182.     myBorKoPairs[i,0].y:=0;
  183.     myBorKoPairs[i,1].x:=charWidth*INTEGER(daten[i].sichtbareZeichen)+Delta;
  184.     myBorKoPairs[i,1].y:=0;
  185.     myBorKoPairs[i,2].x:=charWidth*INTEGER(daten[i].sichtbareZeichen)+Delta;
  186.     myBorKoPairs[i,2].y:=charHeight+Delta;
  187.     myBorKoPairs[i,3].x:=0;
  188.     myBorKoPairs[i,3].y:=charHeight+Delta;
  189.     myBorKoPairs[i,4].x:=0;
  190.     myBorKoPairs[i,4].y:=0;
  191.     WITH myGadgetBorder[i] DO
  192.         leftEdge:=-Delta;
  193.         topEdge:=-Delta;
  194.         frontPen:=1;
  195.          backPen:=0;
  196.          drawMode:=jam1;
  197.         count:=5;
  198.         xy:=ADR(myBorKoPairs[i,0].x);
  199.         nextBorder:=NIL;
  200.     END;
  201.     WITH myStringInfos[i] DO
  202.        buffer:=ADR(daten[i].buffer);
  203.         undoBuffer:=ADR(myUndoBuffer);
  204.        bufferPos:=0;
  205.         maxChars:=BufferLength;
  206.         dispPos:=0;
  207.     END;
  208.         WITH myIntuitionTexts[i] DO
  209.           frontPen:=3;
  210.           backPen:=0;
  211.           drawMode:=jam1;
  212.           leftEdge:= -charWidth*maxTL-2*Delta;
  213.           topEdge:=Delta DIV 2;
  214.           iTextFont:=NIL;
  215.           iText:=ADR(daten[i].text);
  216.           nextText:=NIL;
  217.         END;
  218.         WITH myGadgets[i] DO
  219.           IF i<high THEN
  220.          nextGadget:=ADR(myGadgets[i+1])
  221.       ELSE
  222.          nextGadget:=ADR(okGadget);
  223.        END;
  224.        leftEdge:=charWidth*maxTL+LBorder+3*Delta;
  225.        topEdge:=i*(charHeight+3*Delta)+TBorder+Delta;
  226.        width:=INTEGER(daten[i].sichtbareZeichen) *charWidth;
  227.       height:=charHeight+Delta;
  228.        flags:=GadgetFlagSet{};
  229.       activation:=ActivationFlagSet{gadgImmediate,relVerify};
  230.       gadgetType:=strGadget;
  231.       gadgetRender:=ADR(myGadgetBorder[i]);
  232.        selectRender:=ADR(myGadgetBorder[i]);
  233.       gadgetText:=ADR(myIntuitionTexts[i]);
  234.        mutualExclude:=LONGSET{};
  235.        specialInfo:=ADR(myStringInfos[i]);
  236.        gadgetID:=i;
  237.        userData:=NIL;
  238.     END;
  239.       END;
  240.       WITH myOKImage DO
  241.     leftEdge:=0;
  242.     topEdge:=0;
  243.     width:=OkWidth;
  244.     height:=OkHeight;
  245.     depth:=1;
  246.         IF (ADR(OK1)+OK1Size) >= 80000H THEN
  247.           ok1Adr:=AllocMem(OK1Size,MemReqSet{chip});
  248.           CopyMem(ADR(OK1),ok1Adr,OK1Size);
  249.           imageData:=ok1Adr
  250.         ELSE
  251.           ok1Adr:=NIL;
  252.       imageData:=ADR(OK1)
  253.         END;
  254.     planePick:=1;
  255.     planeOnOff:=2;
  256.     nextImage:=NIL;
  257.       END;
  258.       WITH myCancelImage DO
  259.     leftEdge:=0;
  260.     topEdge:=0;
  261.     width:=CancelWidth;
  262.     height:=CancelHeight;
  263.     depth:=1;
  264.         IF (ADR(Cancel1)+Cancel1Size) >= 80000H THEN
  265.           cancel1Adr:=AllocMem(OK1Size,MemReqSet{chip});
  266.           CopyMem(ADR(Cancel1),cancel1Adr,Cancel1Size);
  267.           imageData:=cancel1Adr
  268.         ELSE
  269.           cancel1Adr:=NIL;
  270.       imageData:=ADR(Cancel1)
  271.         END;
  272.     planePick:=1;
  273.     planeOnOff:=2;
  274.     nextImage:=NIL;
  275.       END;
  276.       WITH okGadget DO
  277.     nextGadget:=ADR(cancelGadget);
  278.         IF (maxSZ-1)*charWidth > (OkWidth+CancelWidth) THEN
  279.       leftEdge:=charWidth*maxTL+LBorder+2*Delta
  280.         ELSE
  281.           leftEdge:=Delta+LBorder;
  282.         END;
  283.     topEdge:=(high+1)*(charHeight+3*Delta)+TBorder+Delta;
  284.     width:=OkWidth;
  285.     height:=OkHeight;
  286.      flags:=GadgetFlagSet{gadgImage};
  287.     activation:=ActivationFlagSet{gadgImmediate};
  288.     gadgetType:=boolGadget;
  289.     gadgetRender:=ADR(myOKImage);
  290.     selectRender:=NIL;
  291.      gadgetText:=NIL;
  292.         mutualExclude:=LONGSET{};
  293.     specialInfo:=NIL;
  294.     gadgetID:=high+1;
  295.     userData:=NIL;
  296.       END;
  297.       WITH cancelGadget DO
  298.     nextGadget:=NIL;
  299.     leftEdge:=(maxSZ+maxTL)*charWidth+LBorder+3*Delta-CancelWidth;
  300.     topEdge:=(high+1)*(charHeight+3*Delta)+TBorder+Delta;
  301.     width:=CancelWidth;
  302.     height:=CancelHeight;
  303.      flags:=GadgetFlagSet{gadgImage};
  304.     activation:=ActivationFlagSet{gadgImmediate};
  305.     gadgetType:=boolGadget;
  306.     gadgetRender:=ADR(myCancelImage);
  307.     selectRender:=NIL;
  308.      gadgetText:=NIL;
  309.         mutualExclude:=LONGSET{};
  310.     specialInfo:=NIL;
  311.     gadgetID:=high+2;
  312.     userData:=NIL;
  313.       END;
  314.     END InitGadgets;
  315.   BEGIN (*AskForStrings*)
  316.     InitGadgets;
  317.     WITH newWindow DO
  318.       leftEdge:=0;
  319.       topEdge:=0;
  320.       width:=(maxSZ+maxTL)*charWidth+RBorder+5*Delta;
  321.       Assert(width<640,ADR('StringInput1:W zu breit'));
  322.       height:=(high+1)*(charHeight+3*Delta)+TBorder+2*Delta+OkHeight;
  323.       Assert(height<256,ADR('StringInput1:W zu hoch'));
  324.       detailPen:=0;
  325.       blockPen:=1;
  326.       idcmpFlags:=IDCMPFlagSet{gadgetDown,gadgetUp,intuiTicks};
  327.       flags:=WindowFlagSet{activate,windowDrag,windowDepth,
  328.                            noCareRefresh,simpleRefresh};
  329.       type:=ScreenFlagSet{wbenchScreen};
  330.       firstGadget:=ADR(myGadgets[0]);
  331.       checkMark:=NIL;
  332.       title:=ADR(windowTitle);
  333.       screen:=NIL;
  334.       bitMap:=NIL;
  335.       minWidth:=30;
  336.       minHeight:=30;
  337.       maxWidth:=640;
  338.       maxHeight:=255;
  339.     END;
  340.     windowPtr:=OpenWindow(newWindow);
  341.     Assert(windowPtr#NIL,ADR('StringInput: Cannot open Window'));
  342.     (*Delay(10);*)
  343.     gaNummer:=0;
  344.     IF ActivateGadget(ADR(myGadgets[gaNummer]),windowPtr,NIL) THEN END;
  345.     ende:=FALSE;
  346.     REPEAT
  347.       WaitPort(windowPtr^.userPort);
  348.       lastKey:=hRegister;
  349.       (*ModifyIDCMP(windowPtr,IDCMPFlagSet{gadgetDown,gadgetUp});*)
  350.       (* damit nicht zu viele intuiTicks eintreffen *)
  351.       msgPtr:=GetMsg(windowPtr^.userPort);
  352.       IF msgPtr# NIL THEN
  353.       class:= msgPtr^.class;
  354.         msgadr:=msgPtr^.iAddress;
  355.       ReplyMsg(msgPtr);
  356.         IF class=IDCMPFlagSet{gadgetDown} THEN
  357.           gaNummer:=msgadr^.gadgetID
  358.         ELSIF  
  359.           (class=IDCMPFlagSet{gadgetUp}) OR (lastKey=CursorDownP) THEN
  360.           IF gaNummer< high THEN
  361.             INC(gaNummer);
  362.             IF (lastKey=CursorDownP) AND PressRButton() THEN END;
  363.             IF ActivateGadget(ADR(myGadgets[gaNummer]),windowPtr,NIL) THEN END;
  364.             Delay(5);
  365.           ELSE
  366.             ende:=(lastKey#CursorDownP)
  367.           END;
  368.         END;
  369.         IF lastKey=CursorUpP THEN
  370.           IF gaNummer> 0 THEN
  371.             DEC(gaNummer);
  372.             IF PressRButton() THEN END;
  373.             IF ActivateGadget(ADR(myGadgets[gaNummer]),windowPtr,NIL) THEN END;
  374.             Delay(5);
  375.           END;
  376.         END;
  377.       END;
  378.       (*ModifyIDCMP(windowPtr,IDCMPFlagSet{gadgetDown,gadgetUp,intuiTicks});*)
  379.     UNTIL ende OR (msgadr^.gadgetID>high);
  380.     Cleanup;
  381.     RETURN (ende OR (msgadr^.gadgetID = INTEGER(anzStrings)));
  382.   END AskForStrings;
  383. BEGIN
  384.   TermProcedure(Cleanup);
  385.   CharSize(charWidth,charHeight);
  386. END StringInput.mod
  387.